(library (grid-gen MPI)

(export MPI:set-nproc
        MPI:args
        MPI:make-multigrid
        MPI:timer-tick
)

(import (guile)
        (rnrs)
        (grid-gen main)
        (grid-gen vars)
        (grid-gen code)
        (grid-gen grid)
        (grid-gen geom)
        (grid-gen OpenMP)
        (grid-gen multigrid)
        (except (srfi srfi-1) map)
)

(define nproc-min #f)
(define nproc-max #f)
(define cur-nproc #f)

(define MPI:set-nproc (lambda (np1 np2)
  (set! nproc-min np1)
  (set! nproc-max np2)
))

(define MPI:args (lambda args
  (if (= (length args) 2)
      (MPI:set-nproc (car args) (cadr args))
      (if (> (length args) 0)
          (int-err "Invalid args for MPI!")
      )
  )
))

(define mpi-float (lambda ()
  (cond ((eq? CODE:precision 4) 'MPI_REAL)
        ((eq? CODE:precision 8) 'MPI_DOUBLE_PRECISION)
        (#t (int-err "Invalid precision: ~a\n" CODE:precision))
  )
))

(define mpi-int (lamcon 'MPI_INTEGER))

(define find-divs (lambda (n d)
  (if (<= d n)
      (if (= (remainder n d) 0)
          (cons d (find-divs n (+ d 1)))
          (find-divs n (+ d 1))
      )
     '()
  )
))

(define ierr (comp-int "ierr"))
(define myid0 (comp-int "mpi_id"))

(define sflg #f)

(define gridnum 1)

(define all-grids '())

(define MPI:grid1 (lambda (dims geomf np grdofs)
  (letrec*
    ((ndims (length dims))
     (npf (map (lambda (x) (* x 1.0)) np))
     (dims1 (map (lambda (x) (apply / x)) (zip dims np)))
     (ndf1  (map (lambda (x) (* x 1.0)) dims1))
     (ncel (apply * dims1))

     (dbg (format #t "\nMPI:grid distribution: ~a, ~a cells.\n" np dims1))
            
     (ids (map (lambda (x) (comp-int   "mpi_d_id")) (iota1 3)))
     (iofs  (comp-array (comp-int   "iofs")  `(,ndims)))
     (vdims (comp-array (comp-int   "dims")    `(,ndims)))
     (vpers (comp-array (comp-int   "periods") `(,ndims)))
            
     (leftx (comp-int "left_x"))
     (lefty (comp-int "left_y"))
     (leftz (comp-int "left_z"))

     (rightx (comp-int "right_x"))
     (righty (comp-int "right_y"))
     (rightz (comp-int "right_z"))
     
     (mycomm (comp-int "comm"))
     (mygrp  (comp-int "grp"))
     (wgrp   (comp-int "wgrp"))
     (rnks   (comp-array (comp-int "rnks") `(,(apply * np))))
            
     (ltau (comp-float "ltau"))
            
     (get-proc-id (lambda (grd ofs)
      `(+ ,(grd 'grdofs) ,(iptr2 ofs (grd 'np)))
     ))

     (mkg (lambda (f0)
       (lambda args
         (apply f0
                (map (lambda (x)
                       (let* ((x0   (list-ref x 0))
                              (Np   (list-ref x 1))
                              (N    (list-ref x 2))
                              (nx   (list-ref x 3))
                             )
                        `(/ (+ (* ,N ,nx) (* ,x0 (- ,nx 1.0)))
                            (- (* ,Np ,nx) 1.0)
                         )
                       )
                     )
                     (zip args
                          (geom:append npf 1.0) 
                          (geom:append
                            (map (lambda (x) (set-ind (del-ind iofs) x))
                                 (map inc (iota1 ndims))
                            )
                            0.0
                          )
                          (geom:append ndf1 10.0)
                     )
                )
         )
       )
     ))
     
     (gr (gr:new dims1 (mkg geomf)))
            
     (vtmp (list))
     (rid  (comp-int "rid"))
     (tv1  (comp-array (comp-float "vt") `(,ncel)))
     
     (mk-forall-d (lambda (dms vrs lam)
;       (format #t "MKFORALL!\n")
       (letrec*
         ((vbsy (make-hash-table))
          (get-vtmp (lambda (d l)
            (if (null? l)
                (let ((v (comp-array (comp-float "vtmp") d)))
                  (set! vtmp (cons v vtmp))
                  (hash-set! vbsy v #t)
                  v
                )
                (if (and (equal? (var-dims (car l)) d)
                         (not (hash-ref vbsy (car l) #f))
                    )
                    (begin
                      (hash-set! vbsy (car l) #t)
                      (car l)
                    )
                    (get-vtmp d (cdr l))
                )
            )
          ))
          (dm0 (car (reverse dms)))
          (tvdims (replace-el dims dm0 (list-ref dims1 dm0)))
          (tvrs (map (lambda (v) (get-vtmp tvdims vtmp)) vrs))
          (cpt (lambda (m)
           `((+ ,(iptr (map (lambda (i) `(- ,(cur-ptr i) ,m)) (iota1 ndims))
                       dims1
                 )
                 1
             )
            )
          ))
         )
         (do-loop-d np (list dm0)
           (beg
            `(if (= ,myid0 0)
                ,(beg
                   (do-loop-d np (cdr (reverse dms))
                     (set-ptr (map cur-ptr dms))
                     (set-val rid
                              (get-proc-id
                                self
                                (map (lambda (d) `(- ,(cur-ptr d) 1))
                                     (iota1 ndims)
                                )
                              )
                     )
                    `(if (= ,rid ,myid0)
                        ,(apply beg
                           (map (lambda (vt)
                                  (do-loop dims1
                                           (set-val 
                                             (set-ind
                                               (del-ind (cadr vt))
                                               (map (lambda (i)
                                                     `(+ (* ,(set-ind
                                                               iofs 
                                                               (inc (car i))
                                                             )
                                                            ,(if (= (car i) dm0)
                                                                 0
                                                                 (cadr i)
                                                             )
                                                         )
                                                        ,(cur-ptr (car i))
                                                      )
                                                    )
                                                    (zip (iota1 ndims) dims1)
                                               )
                                             )
                                             (gr (car vt)
                                                 (map (lamcon (comp-order)) dms)
                                             )
                                           )
                                  )
                                )
                                (zip vrs tvrs)
                           )
                         )
                        ,(apply beg
                           (map (lambda (vi)
                                  (beg
                                    (call "MPI_RECV"
                                          tv1 ncel (mpi-float) rid 
                                          (cadr vi)
                                          'MPI_COMM_WORLD ir ierr
                                    )
                                    (do-loop dims1
                                      (set-val
                                        (set-ind (del-ind (car vi))
                                                 (map (lambda (i)
                                                       `(+ ,(cur-ptr (car i))
                                                            (* ,(if (= (car i)
                                                                       dm0
                                                                    )
                                                                    0
                                                                    (cadr i)
                                                                )
                                                                (- ,(cur-ptr 
                                                                     (+ (car i)
                                                                        ndims
                                                                     )
                                                                    )
                                                                    1
                                                                )
                                                            )
                                                        )
                                                      )
                                                      (zip (iota1 ndims) dims1)
                                                 )
                                        )
                                        (set-ind (del-ind tv1) (cpt 0))
                                      )
                                    )
                                  )
                                )
                                (zip tvrs (iota1 (length vrs)))
                           )
                         )
                     )
                   )
                   (do-loop-d tvdims dms
                     (apply lam
                            (map (lambda (v) (set-ind v (map cur-ptr dms)))
                                 tvrs
                            )
                     )
                   )
                 )
                 (if (and (>= ,myid0 ,grdofs)
                          (< ,myid0 (+ ,grdofs ,(apply * np)))
                     )
                   (if (= ,(set-ind iofs (inc (car (reverse dms))))
                           (- ,(cur-ptr 0) 1)
                       )
                      ,(apply beg
                              (map
                                (lambda (vi)
                                  (beg
                                    (do-loop dims1
                                      (beg
                                        ;; (set-ptr (map cur-ptr dms))
                                        (set-val (set-ind (del-ind tv1)
                                                          (cpt 0)
                                                 )
                                                 (gr (car vi)
                                                     (map (lamcon (comp-order)) dms)
                                                 )
                                        )
                                      )
                                    )
                                    (call "MPI_SEND"
                                          tv1 ncel (mpi-float) 0 
                                          (cadr vi)
                                          'MPI_COMM_WORLD ir ierr
                                    )
                                  )
                                )
                                (zip vrs (iota1 (length vrs)))
                              )
                       )
                       ()
                   )
                   ()
                 )
             )
             (call "MPI_BARRIER" 'MPI_COMM_WORLD ierr)
           )
         )
       )
     ))
            
     (gvrs (gr 'vrs))
     (nvrs (length gvrs))
            
     (bwid  (* (comp-order) nvrs))
     (bsizs (map (lambda (d) (apply * (list-cut dims1 d)))
                 (iota1 ndims)
            )
     )
            
     (blens (map (lambda (s) (* bwid s)) bsizs))
            
     (sbf (map (lambda (l)
                 (list (comp-array (comp-float "sbf") (list l))
                       (comp-array (comp-float "sbf") (list l))
                 )
               )
               blens
          )
     )
     (rbf (map (lambda (l)
                 (list (comp-array (comp-float "rbf") (list l))
                       (comp-array (comp-float "rbf") (list l))
                 )
               )
               blens
          )
     )
     
     (iw (comp-array (comp-int "iw") `(,(* ndims 4))))
     (ir (comp-array (comp-int "ir") `(MPI_STATUS_SIZE ,(* ndims 4))))
     (iwn (comp-int "iwn"))
     (rsp (lambda (d s nv)
       (let* ((bsiz (list-ref bsizs d))
              (dms (replace-el dims1 d (comp-order)))
              (ptr (lambda (s)
                (map (lambda (i)
                      `(- ,(cur-ptr i)
                          ,(if (= i d)
                               (* s (+ (comp-order) (list-ref dims1 d)))
                               (comp-order)
                           )
                       )
                     )
                     (iota1 ndims)
                )
              ))
             )
        `((+ ,(iptr (ptr s) dms) ,(* 2 nv bsiz) 1))
       )
     ))
     (itmp (comp-int "itmp"))
     (ftmp (comp-float "ftmp"))
     (self (lambda args
       (let ((cmd (car args)))
         (cond ((eq? cmd 'dims-full) dims)
               ((eq? cmd 'set-geom) 
                (gr 'set-geom (mkg (cadr args)))
               )
               ((eq? cmd 'clone-bnd)
               	(let ((og (cadr args)))
                  (for-each
                    (lambda (ds)
                      (let ((bnd (og 'getbnd (car ds) (cadr ds)))
                            (bkey (og 'get-bnd-key ds))
                            (bn (string->symbol
                                  (string-append
                                    (list-ref '("x" "y" "z") (car ds))
                                    (list-ref '("-" "+") (cadr ds))
                                  )
                                )
                            )
                           )
                        (if bnd (apply self (append `(add-bnd ,bn) bnd)))
                        (if bkey (self 'set-bnd-key ds bkey))
                      )
                    )
                    (apply append 
                           (map (lambda (d) `((,d 0) (,d 1))) (iota1 ndims))
                    )
                  )
                  (for-each
                    (lambda (vb)
                      (apply self (cons 'add-bnd vb))
                    )
                    (og 'get-vol-bnd)
                  )
                )
               )
               ((eq? cmd 'grdofs) grdofs)
               ((eq? cmd 'np) np)
               ((eq? cmd 'forall-grid)
                (mk-forall-d (iota1 ndims) (cadr args) (caddr args))
               )
               ((eq? cmd 'forall-grid-d)
                (mk-forall-d (cadr args) (caddr args) (cadddr args))
               )
               ((eq? cmd 'update-bnd)
               `(if (and (>= ,myid0 ,grdofs)
                         (< ,myid0 (+ ,grdofs ,(apply * np)))
                    )
                 ,(beg
                    (set-val iwn 0)
                    (apply beg
                      (map (lambda (d)
                             (let* ((sb (list-ref sbf d))
                                    (rb (list-ref rbf d))
                                    (blen (list-ref blens d))
                                    (lid (list-ref `(,leftx ,lefty ,leftz) d))
                                    (rid (list-ref `(,rightx ,righty ,rightz) d))
                                    
                                    (mk-sr (lambda (s)
                                      (beg
                                        (gr 'mkbnd d s
                                          (map (lambda (vi)
                                                 (set-val (set-ind
                                                            (list-ref sb s)
                                                            (rsp d s (cadr vi))
                                                          )
                                                          (gr
                                                            (car vi)
                                                            (map
                                                              (lambda (i)
                                                                (if (= i d)
                                                                  (* (comp-order)
                                                                     (if (= s 0)
                                                                         1
                                                                        -1
                                                                     )
                                                                  )
                                                                  0
                                                                )
                                                              )
                                                              (iota1 ndims)
                                                            )
                                                          )
                                                 )
                                               )
                                               (zip gvrs (iota1 nvrs))
                                          )
                                        )
                                        (set-val iwn `(+ ,iwn 1))
                                        (call "MPI_ISEND"
                                            (list-ref sb s) blen (mpi-float)
                                            (list-ref `(,lid ,rid) s)
                                            (+ (* 100 s) 100 d)
                                            'MPI_COMM_WORLD (set-ind iw iwn) ierr
                                        )
                                        (set-val iwn `(+ ,iwn 1))
                                        (call "MPI_IRECV"
                                            (list-ref rb s) blen (mpi-float)
                                            (list-ref `(,lid ,rid) s)
                                            (+ (* 100 (- 1 s)) 100 d)
                                            'MPI_COMM_WORLD (set-ind iw iwn) ierr
                                        ) 
                                      )
                                    ))
                                   )
                               (beg
                                `(if (>= ,lid 0)
                                    ,(mk-sr 0)
                                     ()
                                 )
                                `(if (>= ,rid 0)
                                    ,(mk-sr 1)
                                     ()
                                 )
                               )
                             )
                           )
                           (iota1 ndims)
                      )
                    )
                   `(if (> ,iwn 0)
                       ,(call "MPI_WAITALL" iwn iw ir ierr)
                        ()
                    )
                    (apply beg
                      (map (lambda (d)
                             (let* ((sb (list-ref sbf d))
                                    (rb (list-ref rbf d))
                                    (cl (gr 'getbnd d 0))
                                    (cr (gr 'getbnd d 1))
                                    (mk-sb (lambda (s)
                                      (beg
                                        (gr 'mkbnd d s
                                          (map (lambda (vi)
                                                 (set-val 
                                                   (gr (car vi))
                                                   (set-ind (list-ref rb s)
                                                            (rsp d s (cadr vi))
                                                   )
                                                 )
                                               )
                                               (zip gvrs (iota1 nvrs))
                                          )
                                        )
                                      )
                                    ))
                                   )
                               (beg
                                `(if (> ,(set-ind iofs (inc d)) 0)
                                    ,(mk-sb 0)
                                    ,(if cl
                                         (if (eq? (car cl) 'grid)
                                             (mk-sb 0)
                                             (gr 'mkbnd d 0 cl)
                                         )
                                     )
                                 )
                                `(if (< ,(set-ind iofs (inc d))
                                         (- ,(list-ref np d) 1)
                                     )
                                    ,(mk-sb 1)
                                    ,(if cr
                                         (if (eq? (car cr) 'grid)
                                             (mk-sb 1)
                                             (gr 'mkbnd d 1 cr)
                                         )
                                     )
                                 )
                               )
                             )
                           )
                           (iota1 ndims)
                      )
                    )
                    (gr 'volbnd)
                    (raw "")
                  )
                  ()
                )
               )
               ((eq? cmd 'init-grid)
                (beg
                  (apply beg
                    (map (lambda (x)
                           (set-val (set-ind (del-ind vdims) (car x))
                                    (cadr x)
                           )
                         )
                         (zip (map inc (iota1 ndims)) np)
                    )
                  )
                  (raw "")
                 `(if (and (>= ,myid0 ,grdofs)
                           (< ,myid0 (+ ,grdofs ,(apply * np)))
                      )
                     ,(beg
                        (letrec* ((r1 `(- ,myid0 ,grdofs))
                                  (rmd (lambda (d)
                                    (if (and (>= d 0) (< d (dec ndims)))
                                       `(+ (* ,(apply
                                                 *
                                                 (list-head np (inc d))
                                               )
                                              ,(set-ind iofs `(,(- ndims d)))
                                           )
                                          ,(rmd (dec d))
                                        )
                                        0
                                    )
                                  ))
                                 )
                          (apply beg
                            (map (lambda (d)
                                   (set-val (set-ind iofs `(,(inc d)))
                                           `(int (/ (- ,r1 ,(rmd d))
                                                   ,(apply * (list-head np d))
                                                 )
                                            )
                                   )
                                 )
                                 (reverse (iota1 ndims))
                            )
                          )
                        )
                        (apply beg
                          (map (lambda (d)
                                 (set-val 
                                   (list-ref `(,leftx ,lefty ,leftz) d)
                                   (get-proc-id
                                     self
                                     (map (lambda (d1)
                                            (if (= d1 d)
                                             `(- ,(set-ind iofs 
                                                          `(,(inc d1))
                                                  )
                                                  1
                                              )
                                              (set-ind iofs `(,(inc d1)))
                                            )
                                          )
                                          (iota1 ndims)
                                     )
                                   )
                                 )
                               )
                               (iota1 ndims)
                          )
                        )
                        (apply beg
                          (map (lambda (d)
                                 (set-val 
                                   (list-ref `(,rightx ,righty ,rightz) d)
                                   (get-proc-id
                                     self
                                     (map (lambda (d1)
                                            (if (= d1 d)
                                             `(+ ,(set-ind iofs `(,(inc d1))) 1)
                                              (set-ind iofs `(,(inc d1)))
                                            )
                                          )
                                          (iota1 ndims)
                                     )
                                   )
                                 )
                               )
                               (iota1 ndims)
                          )
                        )
                        (apply beg
                          (map (lambda (dp)
                                 (let* ((d (car dp))
                                        (p (cadr dp))
                                        (cc (gr 'getbnd d p))
                                        (lr (if (= p 0)
                                                (list-ref 
                                                 `(,leftx ,lefty ,leftz)
                                                  d
                                                )
                                                (list-ref 
                                                 `(,rightx ,righty ,rightz)
                                                  d
                                                )
                                            )
                                        )
                                       )
                                  `(if (= ,(set-ind iofs (inc d))
                                          ,(if (= p 0)
                                               0
                                               (dec (list-ref np d))
                                           )
                                       )
                                      ,(if (and cc (eq? (car cc) 'grid))
                                           (let* ((g2 (list-ref cc 1))
                                                  (b2 (list-ref cc 2))
                                                  (vl2 (list-ref cc 3))
                                                  (mp2 (list-ref cc 4))
                                                  (np2 (g2 'np))
                                                  (ij2 (bnd2ij b2))
                                                  (d20 (car ij2))
                                                  (p2  (cadr ij2))
                                                  (o2 (map 
                                                        (lambda (d1)
                                                          (let ((d2 (assoc
                                                                      d1
                                                                      mp2
                                                                    )
                                                                )
                                                               )
                                                            (if (= d1 d)
                                                                (if (= p2 0)
                                                                  0
                                                                  (dec
                                                                    (list-ref
                                                                      np2
                                                                      d20
                                                                    )
                                                                  )
                                                                )
                                                                (set-ind
                                                                  iofs
                                                                  (inc
                                                                    (cadr d2)
                                                                  )
                                                                )
                                                            )
                                                          )
                                                        )
                                                        (iota1 ndims)
                                                      )
                                                  )
                                                  (p (get-proc-id g2 o2))
                                                 )
                                             (set-val lr p)
                                           )
                                           (set-val lr -1)
                                       )
                                       ()
                                   )
                                 )
                               )
                               (apply append
                                      (map (lambda (d) `((,d 0) (,d 1)))
                                           (iota1 ndims)
                                      )
                               )
                          )
                        )
                     ;   (do-loop `(,(apply * np))
                     ;     (set-val (set-ind rnks (cur-ptr)) 
                     ;             `(+ ,(cur-ptr 0) ,(dec grdofs))
                     ;     )
                     ;   )
                     ;   (call "MPI_COMM_GROUP" 'MPI_COMM_WORLD wgrp ierr)
                     ;   (call "MPI_GROUP_INCL" 
                     ;         wgrp (apply * np) rnks mygrp ierr
                     ;   )
                     ;   (call "MPI_COMM_CREATE"
                     ;         'MPI_COMM_WORLD mygrp mycomm ierr
                     ;   )
                      )
                      ()
                  )
                  (raw "")
                  (gr 'init-grid)
                )
               )
               ((or (eq? cmd 'advection)
                    (eq? cmd 'update-grid-vals)
                    (eq? cmd 'load-grid-vals1)
                    (eq? cmd 'init)
                )
               `(if (and (>= ,myid0 ,grdofs)
                         (< ,myid0 (+ ,grdofs ,(apply * np)))
                    )
                   ,(apply gr args)
                    ()
                )
               )
               ((eq? cmd 'CFL)
                (beg
                 `(if (and (>= ,myid0 ,grdofs)
                           (< ,myid0 (+ ,grdofs ,(apply * np)))
                      )
                     ,(apply gr args)
                      ()
                  )
                  (if (or (not (boolean? (car (reverse args))))
                          (car (reverse args))
                      )
                      (beg
                        (call "MPI_ALLREDUCE"
                              (gr 'tau) ftmp 1 (mpi-float) 'MPI_MIN
                              'MPI_COMM_WORLD ierr
                        )
                        (set-val (gr 'tau) ftmp)
                      )
                      nop
                  )
                )
               )
               ((eq? cmd 'correction)
                (beg
                 `(if (and (>= ,myid0 ,grdofs)
                           (< ,myid0 (+ ,grdofs ,(apply * np)))
                      )
                     ,(apply gr args)
                      ()
                  )
                  (if (or (not (boolean? (car (reverse args))))
                          (car (reverse args))
                      )
                      (beg
                        (call "MPI_ALLREDUCE"
                              (gr 'err) itmp 1 (mpi-int) 'MPI_MAX
                              'MPI_COMM_WORLD ierr
                        )
                        (set-val (gr 'err) itmp)
                      )
                      nop
                  )
                )
               )
               (#t (apply gr args))
         )
       )
     ))
    )
    self
  )
))

(define MPI:init (lambda (cod)
  (let ((numprocs (comp-int "numprocs")))
    (if nproc-min
        (begin
          (list (car cod)
                (beg
                  (call "MPI_INIT" ierr)
                  (call "MPI_COMM_SIZE" 'MPI_COMM_WORLD numprocs ierr)
                  (call "MPI_COMM_RANK" 'MPI_COMM_WORLD myid0 ierr)
                  (raw "")
                 `(if (not (= ,numprocs ,cur-nproc))
                     ,(print (format #f "Need ~a processes to run!" cur-nproc))
                     ,(cons 'CODE_BEGIN (cdr cod))
                  )
                  (raw "")
                  (call "MPI_BARRIER" 'MPI_COMM_WORLD ierr)
                  (call "MPI_FINALIZE" ierr)
                )
          )
        )
        cod
    )
  )
))

(define MPI:mainp (lambda (cod)
  (list (car cod)
       `(if (= ,myid0 0)
           ,(apply beg (cdr cod))
            ()
        )
  )
))

(define MPI:code-to-file (lambda (cod)
  (if (member 'main (caddr cod))
      (list (car cod) (cadr cod) (caddr cod)
           `(= ,myid0 0)
            (list-ref cod 4)
      )
      cod
  )
))



(define act-flg #f)


(define old-make-mg #f)

(define div-grids (lambda (grids)
  (with-amb2
    (letrec* ((grnum (let ((h (make-hash-table)))
                       (for-each
                         (lambda (igr) (hash-set! h (cadr igr) (car igr)))
                         (zip (iota1 (length grids)) grids)
                       )
                       h
                     )
              )
              (grdivs (map (lambda (gr)
                            `(,gr
                              ,(map (lambda (d)
                                      (apply amb2 
                                             (find-divs d 1)
                                      )
                                    )
                                    (gr 'dims)
                               )
                             )
                           )
                           grids
                      )
              )
              (dv0 (cadr (car grdivs)))
              (g0d ((car grids) 'dims))
              (dm0 (map (lambda (dd) (apply / dd)) (zip g0d dv0)))
              (v0 (apply * dm0))
           
              (calc-bs (lambda (d)
                (apply +
                       (map (lambda (x)
                              (apply * (list-cut d x))
                            )
                            (iota1 (length d))
                       )
                )
              ))
              (c-bs (lambda (dims dv)
                (calc-bs (map (lambda (x) (apply / x)) (zip dims dv)))
              ))
              (np (apply + (map (lambda (divs) (apply * divs))
                                (map cadr grdivs)
                           )
                  )
              )
             )
      (amb2-cond (and (>= np nproc-min) (<= np nproc-max)))
      (for-each
        (lambda (grdv)
          (let ((grd ((car grdv) 'dims))
                (dv (cadr grdv))
               )
            (map (lambda (dmdv) (amb2-cond (= (apply remainder dmdv) 0)))
                 (zip grd dv)
            )
            (amb2-cond
              (= (apply * (map (lambda (dd) (apply / dd)) (zip grd dv)))
                 v0
              )
            )
          )
        )
        grdivs
      )
    
      (let ((h (make-hash-table)))
        (for-each
          (lambda (grdv)
            (let* ((gr (car grdv))
                   (dims (gr 'dims))
                   (divs (cadr grdv))
                   (ndims (length dims))
                  )
              (for-each
                (lambda (ds)
                  (let ((key (gr 'get-bnd-key ds)))
                    (if key
                        (let ((gds (hash-ref h key #f)))
                          (if gds
                              (let* ((bnd (gr 'getbnd (car ds) (cadr ds)))
                                     (gn2 (hash-ref grnum (car gds) #f))
                                     (dims2 ((car gds) 'dims))
                                     (divs2 (cadr (list-ref grdivs gn2)))
                                     (mp1 (list-ref bnd 4))
                                    )
                                (for-each
                                  (lambda (d)
                                    (let ((m (assoc d mp1)))
                                      (if m
                                          (amb2-cond (= (list-ref divs d)
                                                        (list-ref divs2 
                                                                  (cadr m)
                                                        )
                                                     )
                                          )
                                      )
                                    )
                                  )
                                  (iota1 ndims)
                                )
                              )
                              (hash-set! h key (cons gr ds))
                          )
                        )
                    )
                  )
                )
                (apply append
                       (map (lambda (d) `((,d 0) (,d 1))) (iota1 ndims))
                )
              )
            )
          )
          grdivs
        )
      )
      (amb2-min
        v0
        (* -1 np)
        (apply max
               (map (lambda (grdv)
                      (let ((grd ((car grdv) 'dims))
                            (dv (cadr grdv))
                           )
                        (c-bs grd dv)
                      )
                    )
                    grdivs
               )
        )
        (* -1
           (apply min
                  (map (lambda (grdv)
                         (let ((grd ((car grdv) 'dims))
                               (dv (cadr grdv))
                              )
                           (apply min
                                  (map (lambda (dd) (apply / dd)) (zip grd dv))
                           )
                         )
                       )
                       grdivs
                  )
           )
        )
      )
    
      (set! cur-nproc np)
      (format #t "\nFound best nproc: ~a\n" np)
      grdivs
    )
  )
))

(define MPI:make-multigrid (lambda (grids)
  (let ((grdivs (div-grids grids)))
    (for-each
      (lambda (igrdv)
        ((car (cadr igrdv)) 'remake-grid
                             (cadr (cadr igrdv))
                             (apply +
                                    (map (lambda (np) (apply * np))
                                         (map cadr 
                                              (list-head grdivs (car igrdv))
                                         )
                                    )
                             )
        )
      )
      (zip (iota1 (length grdivs)) grdivs)
    )
    (set! act-flg #t)
    (let ((omg (old-make-mg grids))
          (ftmp (comp-float "dt"))
          (itmp (comp-int "er"))
         )
      (lambda args
        (let ((cmd (car args)))
        ;;  (format #t "XXX: ~a\n" args)
          (cond ((or (eq? cmd 'CFL) (eq? cmd 'correction))
                 (beg
                   (apply beg
                     (map 
                       (lambda (gri)
                         (let* ((gr (car gri))
                                (i  (cadr gri))
                               )
                           (apply gr (append args `(,(= i 0))))    
                         )
                       )
                       (zip (omg 'subgrids)
                            (reverse (iota1 (length (omg 'subgrids))))
                       )
                     )
                   )
                   (raw "")
                 )
                )
                (#t (apply omg args))
          )
        )
      )
    )
  )
))

(define MPI:grid (lambda (dims geomf)
  (if act-flg (int-err "Some grids was already activated!"))
  (let ((gr (let* ((g0 (gr:new dims geomf))
                   (g g0)
                  )
              (lambda args
                (cond ((eq? (car args) 'remake-grid)
                       (let ((g1 (MPI:grid1 dims geomf (cadr args) (caddr args)
                                 )
                             )
                            )
                         (g1 'clone-bnd g)
                         (set! g g1)
                       )
                      )
                      ((eq? (car args) 'orig-grid) g0)
                      ((eq? (car args) 'dims) 
                       (if act-flg (g 'dims) dims)
                      )
                      ((eq? (car args) 'subgrids) `(,g))
                      (#t (begin
                            (if (and (not act-flg)
                                     (not (or (eq? (car args) 'getbnd)
                                              (eq? (car args) 'get-bnd-key)
                                              (eq? (car args) 'vrs)
                                              (eq? (car args) 'set-bnd-key)
                                              (eq? (car args) 'add-bnd)
                                          )
                                     )
                                )
                                (let* ((grdvs (div-grids (list g)))
                                       (g1 (MPI:grid1 dims 
                                                      geomf
                                                      (cadr (car grdvs))
                                                      0
                                           )
                                       )
                                      )
                         ;;;         (format #t "ACTIVATE!\n")
                                  (set! act-flg #t)
                                  (g1 'clone-bnd g)
                                  (set! g g1)
                                )
                            )
                            (apply g args)
                          )
                      )
                )
              )
            )
        )
       )
    (set! all-grids (cons gr all-grids))
    gr
  )
))

(define MPI:timer-tick (lambda ()
  (let ((ftmp (comp-float "t")))
    (beg
      (time:get-sec ftmp)
      (call "MPI_ALLREDUCE" ftmp code:global-timer 1 (mpi-float) 'MPI_MAX 'MPI_COMM_WORLD ierr)
    )
  )
))

)

(add-wrapper 10 'RUN_CODE MPI:init)
(add-wrapper 10 'CODE_MAINP MPI:mainp)

(add-wrapper 10 'CODE_TO_FILE MPI:code-to-file)

(if (not OpenMP:nproc) (SMP:disable))

(add-include "mpif.h")

(set! grid:cart MPI:grid)

(set! old-make-mg make-multigrid)
(set! make-multigrid MPI:make-multigrid)
(set! timer-tick MPI:timer-tick)
